home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / pull5x.zip / PULLDEMO.PAS < prev    next >
Pascal/Delphi Source File  |  1989-01-01  |  2KB  |  61 lines
  1. { =========================================================================== }
  2. { PullDemo.pas - Full demonstration of pull-down menus.    ver 5.Xa, 01-11-89 }
  3. {                                                                             }
  4. {   Copyright (c) 1987-1989 James H. LeMay, All rights reserved.              }
  5. { =========================================================================== }
  6.  
  7. { R-,S-,I-,D-,T-,F-,V-,B-,N-,L+ }         { TP4 directives }
  8. {$A-,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-}    { TP5 directives }
  9.  
  10. {$M 16384,18000,18000 }
  11.  
  12. program PullDemo;
  13.  
  14. uses
  15.   Crt,Qwik,Wndw,Pull,
  16.   { You must include the following units for this demo! : }
  17.   PullStat,PullData,PullWork,Goof;
  18.  
  19. var
  20.   OrigPathName: string[67];
  21.  
  22. procedure DisplayScreen;
  23. begin
  24.   WWrite ( 1, 1,'PULLDEMO v5.Xa            Multi-level Pu'+
  25.                 'll-down Menus       Copr 1989  J H LeMay');
  26.   ShowTopLine;
  27.   SetWindowModes (PermMode);
  28.   MakeWindow (3,1,CRTrows-3,CRTcols,White+BlueBG,LightGray+BlackBG,DoubleBrdr,
  29.               Window1);
  30.   SetWindowModes (0);
  31.   TitleWindow (Top,Left,SameAttr,'1');
  32.   TWS.WndwAttr := Yellow+BlueBG;
  33.   WWriteC ( 2,'PULL5XA.ARC - MULTI-LEVEL PULL-DOWN MENUS');
  34.   WWriteC ( 9,'This is Work Window 1.');
  35.   TWS.WndwAttr := TWS.OrigAttr;
  36.   WWriteC ( 4,'Use F1 everywhere for some descriptions.');
  37.   WWriteC ( 5,'Use ''Quit'' to exit demo program.        ');
  38.   WWriteC ( 6,'Be sure to try a CR at "≡" marked lines.');
  39.   WWriteC ( 7,'Also try all the EnterData lines.       ');
  40.   WWrite(11, 9,'The following Data Entry fields have some arbitrary values');
  41.   WWrite(12, 9,'and ranges.  Move the highlight and edit.  Press F1 for help.');
  42. end;
  43.  
  44. begin
  45. { Qsnow := false; }
  46.   GetDir (0,OrigPathName);
  47.   PathName := OrigPathName;
  48.   InitPull (LightGray,false);       { <<-- Be sure you do this!! }
  49.   DisplayScreen;
  50.   GotoKeyDispatcher;          { <<-- All keyboard entries go through here! }
  51.   if OrigPathName<>PathName then
  52.     begin
  53.       {$I-} ChDir(OrigPathName); {$I+}
  54.       if IOresult<>0 then OrigPathName:=PathName;
  55.     end;
  56.   AccessWindow (Window0);
  57.   WClrScr;
  58.   WGotoRC (CRTrows,1);
  59.   SetCursor (CursorInitial);
  60. end.
  61.